home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
UTIL
/
Alpha 6.5.sit
/
Tcl
/
SystemCode
/
appleEvents.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
8KB
|
278 lines
# make alias list to pass to AEBuild
proc makeAlis {name} {
return "¥[alis(ヌ[coerce TEXT $name -x alis]ネ)¥]"
}
proc makeFile {name} {
return "alis(ヌ[coerce TEXT $name -x alis]ネ)"
}
proc makeAlises {args} {
set str "¥["
set sep ""
foreach name $args {
append str "${sep}alis(ヌ[coerce TEXT $name -x alis]ネ)"
set sep ","
}
append str "¥]"
return $str
}
# Queued replies are passed through AEPrint and then to this routine.
if {![llength [info command handleReply]]} {
proc handleReply {rep} {
global ALPHA lastReply
# switchTo $ALPHA
set lastReply $rep
}
}
# Return an object record specifying the desired think project file.
proc fileObject {name} {
join [concat {obj¥{want:type('SFIL'), from:'null'(), form:'name', seld:メ} [file tail $name] {モ¥}}] ""
}
proc sendOpenEvent {filler appname fname} {
if {$filler == "noReply"} {
AEBuild $appname aevt odoc "----" [makeAlis $fname]
} else {
AEBuild -r $appname aevt odoc "----" [makeAlis $fname]
}
}
# Send open folder event to Finder. Name must end in colon.
proc openFolder {name} {
if {![regexp ".*:$" $name]} {
append name ":"
}
sendOpenEvent -r Finder $name
}
proc launchDoc {name} {
set app [launchForeAppl [getFileSig $name]]
sendOpenEvent -r [file tail $app] $name
}
# Called from Alpha when titlebar "title" menu selected (command-mouse).
proc getTitleBarPath {} {
global fetched
set f [car [winNames -f]]
if {[info exists fetched($f)]} {
set nm "[car $fetched($f)]/[cadr $fetched($f)]/[file tail $f]"
regsub -all {//} $nm {/} nm
regsub -all {/} $nm {:} nm
return $nm
} else {
return $f
}
}
proc titlebar {name} {
global fetched
if {[info exists fetched([car [winNames -f]])]} {
set specs $fetched([car [winNames -f]])
regsub -all {:} $name {/} name
regexp {[^/]+/(.*)} $name dummy dir
ftpBrowse [car $specs] $dir [caddr $specs] [cadddr $specs]
} else {
if {[file isdir $name]} {
switchTo Finder
openFolder $name
}
}
}
# Send multiple open events
proc sendOpenEvents {appname args} {
AEBuild -r $appname aevt odoc "----" [eval makeAlises $args]
}
proc openAndSendFile {sig} {
set fname [car [winNames -f]]
if {[winDirty]} {
if {[askyesno "Save '$fname'?"] == "yes"} {
save
}
}
set name [file tail [launchForeAppl $sig]]
sendOpenEvent noReply $name $fname
}
#================================================================================
# General Apple Event handling routines
#
# (written by Tom Pollard for use in the MacPerl package)
#================================================================================
# Quit an application.
proc sendQuitEvent {appname} {
AEBuild $appname "aevt" "quit"
}
# Close one of an application's windows, designated by number.
proc sendCloseWinNum {appname num} {
AEBuild $appname "core" "clos" "----" [AEWinByPos $num]
}
# Close one of an application's windows, designated by name.
proc sendCloseWinName {appname name} {
AEBuild $appname "core" "clos" "----" [AEWinByName $name]
}
# Obtain the number of lines in one of an application's
# windows, designated by name.
proc sendCountLines {appname name} {
set winObj [AEWinByName $name]
set res [AEBuild -r $appname "core" "cnte" "----" $winObj kocl type('clin')]
if {[regexp {:(.*)¥}} $res allofit nlines]} {
return $nlines
} else {
return 0
}
}
# Get a selected range of lines from one of an application's
# windows, designated by name. If $last is missing, then a single
# line is returned; if both $first and $last are missing, then
# the complete window contents are returned.
proc sendGetText {appname name {first {missing}} {last {missing}}} {
global ALPHA
set winObj [AEWinByName $name]
if {$first != "missing"} {
if {$last != "missing"} {
set rangDesc [AELineRange $first $last]
} else {
set rangDesc [AEAbsPos $first]
}
set objDesc "obj{want:type('clin'), from:$winObj, $rangDesc }"
} else {
set objDesc "obj{want:type('ctxt'), from:$winObj, form:'indx', seld:abso('all') }"
}
set res [AEBuild -r $appname "core" "getd" "----" $objDesc]
if {![regexp {メ.*モ} $res text]} { set text {} }
return [string trim $text {メモ}]
}
# Set a selected range of lines in one of an application's
# windows, designated by name. If $last is missing, then a single
# line is changed; if both $first and $last are missing, then
# the complete window contents are replaced by the new text.
proc sendSetText {appname name text {first {missing}} {last {missing}}} {
set winObj [AEWinByName $name]
if {$first != "missing"} {
if {$last != "missing"} {
set rangDesc [AELineRange $first $last]
} else {
set rangDesc [AEAbsPos $first]
}
set objDesc "obj{want:type('clin'), from:$winObj, $rangDesc }"
} else {
set objDesc "obj{want:type('ctxt'), from:$winObj, form:'indx', seld:abso('all') }"
}
set res [AEBuild -r $appname "core" "setd" "----" $objDesc "data" [curlyq $text]]
if {![regexp {メ.*モ} $res text]} { set text {} }
return [string trim $text {メモ}]
}
################################################################################
# Utility functions for constructing AppleEvent descriptors for AEBuild
################################################################################
proc AEFilename {name} {
return "obj{want:type('file'), from:'null'(), [AEName $name] } "
}
proc AEWinByName {name} {
return "obj{want:type('cwin'), from:'null'(), [AEName $name] } "
}
proc AEWinByPos {absPos} {
return "obj{want:type('cwin'), from:'null'(), [AEAbsPos $absPos] } "
}
proc AELineRange {absPos1 absPos2} {
set lineObj1 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos1] }"
set lineObj2 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos2] }"
return "form:'rang', seld:rang{star:$lineObj1, stop:$lineObj2 } "
}
proc AEAbsPos {posName} {
#
# Use '1' or 'first' to specify first position
# and '-1' or 'last' to specify last position.
#
if {$posName == "first"} {
set posName 1
} elseif {$posName == "last"} {
set posName -1
}
if {$posName >= -1} {
return "form:indx, seld:long($posName)"
} else {
error "AEAbsPos: bad argument"
}
}
proc AEName {name} {
return "form:'name', seld:[curlyq $name]"
}
proc curlyq {str} {
return "¥メ$str¥モ"
}
################################################################################
proc nullObject {} { return "'null'()" }
proc objectType {type} { return "type($type)" }
proc nameObject {type name from} { return "obj ¥{form:name, want:[objectType $type], seld:$name, from:$from¥}" }
proc indexObject {type ind from} { return "obj ¥{form:indx, want:[objectType $type], seld:$ind, from:$from¥}" }
proc propertyObject { prop object } { return "obj ¥{form:prop, want:[objectType prop], seld:[objectType $prop], from:$object¥}" }
# 'process' must have single quotes
proc buildMsgReply { process suite event args } { return [eval [list AEBuild -r $process $suite $event ] $args] }
proc countObjects { process fromObject class } {
set res [AEBuild -r $process core cnte ---- $fromObject kocl [objectType $class]]
if {[regexp {:([0-9]+)} $res dummy mtch]} {
return $mtch
} else {
error "Bad count proc"
}
}
proc createThingAtEnd {process container class} {
set res [AEBuild -r $process core crel insh "insl ¥{kobj:$container¥}" kocl "type($class)"]
}
proc getObjectData { process class name from } {
set res [AEBuild -r $process core getd ---- [nameObject $class "メ$nameモ" $from] {rtyp{type:TEXT}}]
if {[regexp {メ(.*)モ} $res dummy mtch]} {
return $mtch
} else {
error "Bad count proc"
}
}
proc objectProperty { process property object } {
AEBuild -r $process core getd ---- [propertyObject $property $object]
}
# Extract and return a path from a result.
proc extractPath {res} {
if {[regexp {ヌ(.*)ネ} $res dummy fss]} {
return [specToPathName $fss]
}
error "bad path $name"
}